home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 011 / lupc.bas < prev    next >
BASIC Source File  |  1988-11-09  |  27KB  |  477 lines
  1. 100 REM ----------------------------------------------------------------------
  2. 110 REM | Copyright (c) 1983 - Scott Loftesness. All Rights Reserved.        |
  3. 120 REM | Program Name: LU --- A BASIC Library Manager                       |
  4. 130 REM | Author:       Scott Loftesness                                     |
  5. 140 REM |               20324 Highland Hall Drive                            |
  6. 150 REM |               Gaithersburg, MD 20879                               |
  7. 160 REM | Date:         4/16/83                                              |
  8. 170 REM | Purpose:                                                           |
  9. 180 REM |  To manage a library containing several files in a single file.    |
  10. 190 REM |  This program is based on the library format by G. Novosielski     |
  11. 195 REM |  modified by Scott Loftesness to add date and time information.    |
  12. 200 REM ----------------------------------------------------------------------
  13. 210 DEFINT A-Z:CLS:KEY OFF
  14. 215 TITLE$="PC/Library (Version 1.0 - 4/16/83)"
  15. 220 LOCATE 1,1:PRINT STRING$(79,&HC4);
  16. 230 LOCATE 24,1:PRINT STRING$(79,&HC4);
  17. 240 FOR I=1 TO 24:LOCATE I,1:PRINT CHR$(&HB3);
  18. 245 LOCATE I,79:PRINT CHR$(&HB3);:NEXT I
  19. 250 LOCATE 1,1:PRINT CHR$(&HDA);:LOCATE 1,79:PRINT CHR$(&HBF);:LOCATE 24,1:PRINT CHR$(&HC0);:LOCATE 24,79:PRINT CHR$(&HD9);
  20. 260 LOCATE 3,2:H1$="Library Utility (LU) for the IBM Personal Computer":GOSUB 990
  21. 270 LOCATE 4,2:H1$="Version 1.0 - (C) Copyright 1983 - Scott Loftesness":GOSUB 990                                                                            
  22. 280 DIM I$(100),S$(10):S$(1)="Build New Library"
  23. 290 S$(2)="List Library Directory"
  24. 300 S$(3)="List Directory & Add Library Member"
  25. 310 S$(4)="List Directory & Get Library Member"
  26. 320 S$(5)="List Directory & List Library Member"
  27. 330 S$(6)="List Directory & Delete Library Member"
  28. 340 S$(7)="Spread Library to Individual Files"
  29. 345 S$(8)="Reorganize Existing Library"
  30. 347 S$(9)="Return to PC-DOS"
  31. 350 START=6
  32. 360 FOR I=1 TO 9
  33. 370 LOCATE START,20
  34. 380 PRINT S$(I);" ";STRING$(40-LEN(S$(I)),".");I;
  35. 390 START=START+2
  36. 400 NEXT I
  37. 410 LOCATE START+1,2
  38. 420 PRINT "Your Selection Please: ";:BEEP
  39. 430 LOCATE ,,1,0,11
  40. 440 I$=INKEY$:IF I$="" THEN 440
  41. 450 LOCATE ,,0:IF LEN(I$)>1 THEN BEEP:GOTO 440
  42. 460 IF (VAL(I$)>0) AND (VAL(I$)<10) THEN ON VAL(I$) GOTO 1000,4000,8000,3000,3000,7000,5000,995,6000
  43. 470 BEEP:LOCATE 25,40:PRINT SPC(25);:LOCATE 25,40:PRINT "ERROR- Invalid Selection!";:GOTO 410
  44. 500 REM ----------------------------------------------------------------------
  45. 510 REM | Subroutine to Get Filename Info from user.                         |
  46. 520 REM ----------------------------------------------------------------------
  47. 530 INPUT "Enter library name (w/o extension):",ARCHNAME$
  48. 540 IF ARCHNAME$="" THEN RETURN
  49. 550 IF INSTR(ARCHNAME$,".")<>0 THEN PRINT:PRINT "ERROR - Invalid file name specified - do not specify extension.":PRINT:GOTO 530
  50. 560 ARCHFIL$=ARCHNAME$+".lbr":ARCHDIR$=ARCHFIL$
  51. 570 RETURN
  52. 600 REM ----------------------------------------------------------------------
  53. 610 REM | Subroutine to Copy file into library (From #3 to #2)               |
  54. 620 REM ----------------------------------------------------------------------
  55. 630 FOR L!=0 TO LOF(3)-1 STEP 128
  56. 640 GET #3
  57. 650 FIELD 3, 128 AS INREC$
  58. 660 RECCNT=RECCNT+1
  59. 670 FIELD 2, 128 AS OUTREC$
  60. 680 LSET OUTREC$=INREC$
  61. 690 PUT #2,RECCNT
  62. 700 NEXT L!
  63. 710 RETURN
  64. 720 REM ----------------------------------------------------------------------
  65. 730 REM | Subroutine to List Directory Contents                              |
  66. 740 REM ----------------------------------------------------------------------
  67. 750 PRINT "Directory Contents for Library File: ";ARCHNAME$+".LBR"
  68. 760 PRINT:PRINT   " File  Name  Start # Sec Bytes --Date-- --Time--"
  69. 780 PRINT         "------------ ----- ----- ----- -------- --------"
  70. 790 HILAST=0:'Highest sector in use.
  71. 800 NUMDIR=0:'Number of valid directory entries.
  72. 810 GET #1:' Skip over directory entry itself.
  73. 814 FIELD 1, 1 AS DONE$, 8 AS PRINAME$, 3 AS SECNAME$, 2 AS START$, 2 AS LAST$, 8 AS FILEDATE$, 8 AS FILETIME$
  74. 816 TOTDIR=(CVI(LAST$)*4)-1
  75. 820 GET #1
  76. 830 FIELD 1, 1 AS DONE$, 8 AS PRINAME$, 3 AS SECNAME$, 2 AS START$, 2 AS LAST$, 8 AS FILEDATE$, 8 AS FILETIME$
  77. 840 IF DONE$=CHR$(255) THEN GOTO 930:'Exit if complete
  78. 845 NUMDIR=NUMDIR+1
  79. 850 IF DONE$=CHR$(254) THEN GOTO 820:'Skip deleted files.
  80. 860 IF HILAST<CVI(START$) THEN HILAST=CVI(START$):LASTSEC=CVI(LAST$):'Save highest sector in use.
  81. 880 PRINT PRINAME$;" ";SECNAME$;
  82. 890 PRINT USING " #####";CVI(START$);CVI(LAST$);128*CVI(LAST$);:PRINT " ";FILEDATE$;" ";FILETIME$
  83. 910 GOTO 820
  84. 930 RETURN
  85. 940 REM ----------------------------------------------------------------------
  86. 941 REM | Subroutine to Copy file out of library (From #2 to #3)             |
  87. 942 REM ----------------------------------------------------------------------
  88. 943 FOR I=1+CVI(START$) TO 1+CVI(START$)+CVI(LAST$)-1
  89. 944 GET #2,I
  90. 946 FIELD 2, 128 AS INREC$
  91. 947 FIELD 3, 128 AS OUTREC$
  92. 948 LSET OUTREC$=INREC$
  93. 949 PUT #3
  94. 950 NEXT I
  95. 951 RETURN
  96. 952 REM ----------------------------------------------------------------------
  97. 953 REM | Subroutine to list a file in a library                             |
  98. 954 REM ----------------------------------------------------------------------
  99. 955 FOR I=1+CVI(START$) TO (CVI(START$)+CVI(LAST$))
  100. 956 GET #2,I
  101. 957 FIELD 2, 128 AS INREC$
  102. 958 PRINT INREC$;
  103. 959 NEXT I
  104. 960 RETURN
  105. 980 GOTO 980                                                                  
  106. 990 LOCATE ,((78-LEN(H1$))/2):PRINT H1$;:RETURN
  107. 995 LOCATE 25,40:PRINT "ERROR - Option Not Implemented Yet!";:BEEP:GOTO 410
  108. 1000 REM -----------------------------------------------------------------------
  109. 1020 REM | Program Name: LUBLD -- A BASIC Library Builder                      |
  110. 1070 REM | Purpose:                                                            |
  111. 1080 REM |  To create an library from several individual input files.          |
  112. 1090 REM |  This program is based on the library format by G. Novosielski.     |
  113. 1100 REM | Comments:                                                           |
  114. 1110 REM |  Input is an uncompressed library filename (without any extension). |
  115. 1120 REM |  This program creates an library with the user specified name.      |
  116. 1130 REM |  Filenames created are of the form:                                 |
  117. 1140 REM |             <filename>.lbr                                          |
  118. 1150 REM |  which contains a directory portion and a data portion.             |
  119. 1160 REM |                                                                     |
  120. 1170 REM |  The directory contains a 32 byte record for each file in the       |
  121. 1180 REM |  library. The format of this record is as follows:                  |
  122. 1190 REM |  Offset Length Description                                          |
  123. 1200 REM |    0      1    Flag Byte - as follows:                              |
  124. 1210 REM |                00 - Indicates an active directory entry.            |
  125. 1220 REM |                FE - Indicates a deleted entry.                      |
  126. 1230 REM |                FF - Indicates an unused entry.                      |
  127. 1240 REM |    1      8    Primary file name - must be upper case. Left         |
  128. 1250 REM |                justified with blanks.                               |
  129. 1260 REM |    9      3    File extension - must be upper case. Left just.      |
  130. 1270 REM |   12      2    Starting record number in <filename>.LBR for this    |
  131. 1280 REM |                file. (Records are 128 bytes long)                   |
  132. 1290 REM |   14      2    Number of sectors in file.                           |
  133. 1300 REM |   16      8    Member creation date.                                |
  134. 1305 REM |   24      8    Member creation time.                                |
  135. 1310 REM |  The library file itself consists of 128 byte records. If a file    |
  136. 1320 REM |  is not an even multiple of 128 bytes in length, the final record   |
  137. 1330 REM |  is padded to make the file an even multiple. The pad character is  |
  138. 1340 REM |  chr$(00).                                                          |
  139. 1350 REM | Requires:                                                           |
  140. 1360 REM |  This program is written in IBM Personal Computer Disk BASIC.       |
  141. 1370 REM |  This program operates only in 80 character wide text mode. It      |
  142. 1380 REM |  assumes the screen is in that mode at entry.                       |
  143. 1390 REM -----------------------------------------------------------------------
  144. 1400 CLS
  145. 1410 GOSUB 500 ' Get Filename from User.
  146. 1420 IF ARCHNAME$="" THEN GOSUB 6100:RUN
  147. 1450 ON ERROR GOTO 2180:'Test for file available.
  148. 1460 OPEN ARCHFIL$ FOR INPUT AS #1:CLOSE #1
  149. 1470 PRINT:PRINT "File "+ARCHFIL$+" already exists. Re-write this file? <N/Y>";:INPUT I$
  150. 1480 IF I$="Y" OR I$="y" THEN GOTO 1490 ELSE GOTO 1410
  151. 1490 ON ERROR GOTO 0:'Delete file not available error routine.
  152. 1500 PRINT:INPUT "Enter maximum number of entries library is to contain:";NUMENT
  153. 1510 NUMENT=NUMENT+1:NUMDIR=NUMENT\4
  154. 1520 IF NUMENT MOD 4>0 THEN NUMDIR=NUMDIR+1
  155. 1530 CLS:PRINT "LUBLD    -    ";TITLE$
  156. 1540 PRINT:PRINT"Formatting library directory...";
  157. 1550 OPEN ARCHFIL$ AS #1 LEN=32
  158. 1560 FOR I=1 TO NUMENT*4
  159. 1570 FIELD 1, 1 AS DONE$, 8 AS PRINAME$, 3 AS SECNAME$, 2 AS START$, 2 AS LAST$, 8 AS FILEDATE$, 8 AS FILETIME$
  160. 1580 LSET DONE$=CHR$(255):LSET PRINAME$=STRING$(8,0):LSET SECNAME$=STRING$(3,0)
  161. 1590 LSET START$=MKI$(0):LSET LAST$=MKI$(0)
  162. 1595 WKDATE$=DATE$:WKDATE$=LEFT$(WKDATE$,6)+RIGHT$(WKDATE$,2):LSET FILEDATE$=WKDATE$:LSET FILETIME$=TIME$
  163. 1600 PUT #1
  164. 1610 NEXT I
  165. 1620 LSET DONE$=CHR$(0):LSET PRINAME$="********":LSET SECNAME$="DIR":LSET START$=MKI$(0):LSET LAST$=MKI$(NUMDIR):PUT #1,1
  166. 1630 CLOSE #1
  167. 1640 PRINT"Format complete."
  168. 1650 OPEN ARCHFIL$ AS #2 LEN=128
  169. 1660 PRINT:PRINT "Enter filenames to be added to library ";ARCHNAME$;". Enter null line to terminate."
  170. 1670 NUMFILES=0
  171. 1680 ON ERROR GOTO 2190
  172. 1690 NUMFILES=NUMFILES+1:PRINT "Filename #";NUMFILES;" <drv:filename.ext> :";:INPUT I$(NUMFILES)
  173. 1700 IF LEN(I$(NUMFILES))=0 THEN NUMFILES=NUMFILES-1:GOTO 1800
  174. 1710 FOR I=1 TO LEN(I$(NUMFILES))
  175. 1720 IF ASC(MID$(I$(NUMFILES),I))>96 THEN MID$(I$(NUMFILES),I)=CHR$(ASC(MID$(I$(NUMFILES),I))-32)
  176. 1730 NEXT I
  177. 1740 FOR J=1 TO NUMFILES-1
  178. 1750 IF I$(NUMFILES)=I$(J) THEN PRINT "ERROR - Same file specified twice.":NUMFILES=NUMFILES-1:GOTO 1690
  179. 1760 NEXT J
  180. 1770 OPEN I$(NUMFILES) FOR INPUT AS #3:CLOSE #3
  181. 1780 IF NUMFILES=NUMENT THEN GOTO 1800
  182. 1790 GOTO 1690
  183. 1800 ON ERROR GOTO 0
  184. 1810 IF NUMFILES<1 THEN PRINT "ERROR - No files specified.":GOTO 1660
  185. 1820 PRINT:PRINT NUMFILES;" files to be included in Library ";ARCHNAME$
  186. 1830 RECCNT=NUMDIR
  187. 1840 FOR I=1 TO NUMFILES
  188. 1850 INCNT=0
  189. 1860 OPEN I$(I) AS #3 LEN=128
  190. 1870 PRINT:PRINT "Copying file #";I;": ";I$(I);" (";LOF(3);"bytes ) --> Library: ";ARCHFIL$
  191. 1880 STARTCNT=RECCNT
  192. 1890 GOSUB 600 ' Go copy the file into the library.
  193. 1970 CLOSE #3
  194. 1980 CLOSE #2
  195. 1990 OPEN ARCHFIL$ AS #1 LEN=32
  196. 2000 FIELD 1, 1 AS DONE$, 8 AS PRINAME$, 3 AS SECNAME$, 2 AS START$, 2 AS LAST$, 8 AS FILEDATE$, 8 AS FILETIME$
  197. 2010 LSET PRINAME$="":LSET SECNAME$=""
  198. 2020 LSET START$=MKI$(STARTCNT)
  199. 2030 LSET LAST$=MKI$(RECCNT-STARTCNT)
  200. 2040 LSET DONE$=CHR$(0)
  201. 2045 WKDATE$=DATE$:WKDATE$=LEFT$(WKDATE$,6)+RIGHT$(WKDATE$,2):LSET FILEDATE$=WKDATE$:LSET FILETIME$=TIME$
  202. 2050 IF INSTR(I$(I),":")=2 THEN PRI$=MID$(I$(I),3) ELSE PRI$=I$(I)
  203. 2060 IF INSTR(PRI$,".")<>0 THEN SEC$=MID$(PRI$,INSTR(PRI$,".")+1):PRI$=MID$(PRI$,1,INSTR(PRI$,".")-1)
  204. 2070 LSET PRINAME$=PRI$+SPACE$(8-LEN(PRI$))
  205. 2080 LSET SECNAME$=SEC$+SPACE$(3-LEN(SEC$))
  206. 2090 PUT #1,I+1
  207. 2100 LSET DONE$=CHR$(255)
  208. 2110 PUT #1
  209. 2120 CLOSE #1
  210. 2130 OPEN ARCHFIL$ AS #2 LEN=128
  211. 2140 NEXT I
  212. 2150 CLOSE
  213. 2160 PRINT:PRINT "Library build completed - directory updated."
  214. 2170 GOSUB 6100:RUN
  215. 2180 IF ERR=53 THEN RESUME 1490 ELSE ON ERROR GOTO 0
  216. 2190 IF ERR=53 THEN PRINT:PRINT "File: ";I$(NUMFILES);" cannot be opened. Please re-specify.":NUMFILES=NUMFILES-1:RESUME 1690 ELSE ON ERROR GOTO 0
  217. 3000 REM ----------------------------------------------------------------------
  218. 3020 REM | Program Name: LUGET -- A BASIC Library File Retriever              |
  219. 3070 REM | Purpose:                                                           |
  220. 3080 REM |  To copy a file from an library to a separate file.                |
  221. 3090 REM |  This program is based upon the LU library format by G. Novosielski|
  222. 3100 REM | Comments:                                                          |
  223. 3110 REM |  Input is an uncompressed library filename (without any extension).|
  224. 3120 REM |  This program reads and lists the contents of the library          |
  225. 3130 REM |  directory. It then prompts the user for the name of the file to   |
  226. 3140 REM |  be retrieved. Filename is of the form:                            |
  227. 3150 REM |             <filename>.lbr                                         |
  228. 3160 REM | Requires:                                                          |
  229. 3170 REM |  This program is written in IBM Personal Computer Disk BASIC.      |
  230. 3180 REM |  This program operates only in 80 character wide text mode. It     |
  231. 3190 REM |  assumes the screen is in that mode at entry.                      |
  232. 3200 REM ----------------------------------------------------------------------
  233. 3210 CLS
  234. 3220 GOSUB 500
  235. 3230 IF ARCHNAME$="" THEN GOSUB 6100:RUN
  236. 3270 ON ERROR GOTO 3880:'Test for file available.
  237. 3280 OPEN ARCHDIR$ FOR INPUT AS #1:CLOSE #1
  238. 3290 OPEN ARCHFIL$ FOR INPUT AS #2:CLOSE #2
  239. 3300 ON ERROR GOTO 0:'Delete file not available error routine.
  240. 3310 OPEN ARCHDIR$ AS #1 LEN=32
  241. 3320 CLS:IF VAL(I$)=4 THEN PRINT "LUGET    -    ";TITLE$
  242. 3325 IF VAL(I$)=5 THEN PRINT "LUTYPE   -    ";TITLE$
  243. 3330 GOSUB 720
  244. 3510 PRINT:IF VAL(I$)=4 THEN INPUT "Enter file name to be retrieved :";GETFIL$
  245. 3515 IF VAL(I$)=5 THEN INPUT "Enter file name to be listed :";GETFIL$
  246. 3520 IF GETFIL$="" THEN GOSUB 6100:RUN
  247. 3530 IF LEN(GETFIL$)>12 THEN PRINT "ERROR - Filename is too long.":GOTO 3510
  248. 3540 FOR I=1 TO LEN(GETFIL$):'Translate to upper case.
  249. 3550 IF ASC(MID$(GETFIL$,I))>96 THEN MID$(GETFIL$,I)=CHR$(ASC(MID$(GETFIL$,I))-32)
  250. 3560 NEXT I
  251. 3570 IF INSTR(GETFIL$,".")<>0 THEN GETPRI$=LEFT$(GETFIL$,INSTR(GETFIL$,".")-1):GETSEC$=MID$(GETFIL$,INSTR(GETFIL$,".")+1)
  252. 3580 FOR I=2 TO NUMDIR+1
  253. 3590 GET #1,I
  254. 3600 FIELD 1, 1 AS DONE$, 8 AS PRINAME$, 3 AS SECNAME$, 2 AS START$, 2 AS LAST$
  255. 3605 IF DONE$=CHR$(254) THEN GOTO 3620
  256. 3610 IF GETPRI$+STRING$(8-LEN(GETPRI$)," ")=PRINAME$ THEN IF GETSEC$+STRING$(3-LEN(GETSEC$)," ")=SECNAME$ THEN GOTO 3640
  257. 3620 NEXT I
  258. 3630 PRINT:PRINT "ERROR - File not found.":GOTO 3510
  259. 3640 OPEN ARCHFIL$ AS #2 LEN=128
  260. 3650 OUTFIL$=""
  261. 3660 IF INSTR(ARCHNAME$,":")=2 THEN OUTFIL$=LEFT$(ARCHNAME$,2)
  262. 3670 OUTFIL$=OUTFIL$+GETPRI$+"."+GETSEC$
  263. 3675 IF VAL(I$)=5 THEN GOTO 3780
  264. 3680 PRINT:PRINT "Re-specify filename or hit enter to use:";OUTFIL$;:INPUT Q$
  265. 3690 IF Q$="" THEN GOTO 3700 ELSE OUTFIL$=Q$
  266. 3700 ON ERROR GOTO 3900
  267. 3710 OPEN OUTFIL$ FOR INPUT AS #3
  268. 3720 PRINT:PRINT "WARNING - File ";OUTFIL$;" already exists. Re-write existing file? <N/Y>";:INPUT Q$
  269. 3730 IF Q$="Y" OR Q$="y" THEN GOTO 3740 ELSE PRINT "LUGET - Execution terminated.":CLOSE #3:GOSUB 6100:RUN
  270. 3740 CLOSE #3
  271. 3750 ON ERROR GOTO 0
  272. 3760 OPEN OUTFIL$ AS #3 LEN=128
  273. 3770 PRINT:PRINT"Copying file ";GETPRI$+"."+GETSEC$;" from library ";ARCHFIL$;" (";128*CVI(LAST$);" bytes) to file ";OUTFIL$;"."
  274. 3780 IF VAL(I$)=4 THEN GOSUB 940
  275. 3785 IF VAL(I$)=5 THEN CLS:GOSUB 952
  276. 3850 CLOSE
  277. 3860 PRINT:IF VAL(I$)=4 THEN PRINT "LUGET - Copy completed." ELSE PRINT:PRINT "LUTYPE - Listing Completed."
  278. 3870 GOSUB 6100:RUN
  279. 3880 IF ERR=53 THEN PRINT "ERROR - File not found.":RESUME 3220
  280. 3890 ON ERROR GOTO 0
  281. 3900 IF ERR=53 THEN RESUME 3760
  282. 3910 IF ERR=64 THEN PRINT"ERROR - Invalid filename specified.":RESUME 3650
  283. 3920 ON ERROR GOTO 0
  284. 4000 REM ----------------------------------------------------------------------
  285. 4020 REM | Program Name: LUDIR -- A BASIC Library Directory Lister            |
  286. 4070 REM | Purpose:                                                           |
  287. 4080 REM |  To list the contents of an library directory.                     |
  288. 4090 REM |  Uses the library format devised by Gary Novosielski for CP/M.     |
  289. 4100 REM | Comments:                                                          |
  290. 4110 REM |  Input is an uncompressed library filename (without any extension).|
  291. 4120 REM |  This program reads and lists the contents of the library          |
  292. 4130 REM |  directory. Filename  is  assumed to be of the form:               |
  293. 4140 REM |             <filename>.lbr                                         |
  294. 4150 REM | Requires:                                                          |
  295. 4160 REM |  This program is written in IBM Personal Computer Disk BASIC.      |
  296. 4170 REM |  This program operates only in 80 character wide text mode. It     |
  297. 4180 REM |  assumes the screen is in that mode at entry.                      |
  298. 4190 REM ----------------------------------------------------------------------
  299. 4200 CLS
  300. 4210 GOSUB 500
  301. 4220 IF ARCHNAME$="" THEN GOSUB 6100:RUN
  302. 4250 ON ERROR GOTO 4440:'Test for file available.
  303. 4260 OPEN ARCHDIR$ FOR INPUT AS #1:CLOSE #1
  304. 4270 ON ERROR GOTO 0:'Delete file not available error routine.
  305. 4280 OPEN ARCHDIR$ AS #1 LEN=32
  306. 4290 CLS:PRINT "LUDIR    -    ";TITLE$
  307. 4300 GOSUB 720
  308. 4310 GOSUB 6100:RUN
  309. 4440 IF ERR=53 THEN PRINT "ERROR - File not found.":RESUME 4210
  310. 4450 IF ERR=64 THEN PRINT "ERROR - Bad filename specified.":RESUME 4210
  311. 4460 ON ERROR GOTO 0
  312. 5000 REM ----------------------------------------------------------------------
  313. 5020 REM | Program Name: LUSPR -- A  Library Expander                         |
  314. 5070 REM | Purpose:                                                           |
  315. 5080 REM |  To completely unload a  library to individual files.              |
  316. 5090 REM | Comments:                                                          |
  317. 5100 REM |  Input is an uncompressed library filename (without any extension).|
  318. 5110 REM |  This program reads the directory and creates new files from the   |
  319. 5120 REM |  directory / source file. Filenames are assumed to be of the form: |
  320. 5130 REM |             <filename>.lbr                                         |
  321. 5140 REM |  Output files will be created based upon the contents of the dir-  |
  322. 5150 REM |  ectory.       These new files will be allocated on the same drive |
  323. 5160 REM |  that contains the library itself. Library files are assumed to    |
  324. 5170 REM |  be in the format originated by Gary Novosielski   for CP/M systems|
  325. 5180 REM |  and widely used on Remote CP/M systems.                           |
  326. 5190 REM | Requires:                                                          |
  327. 5200 REM |  This program is written in IBM Personal Computer Disk BASIC.      |
  328. 5210 REM |  This program assumes an 80 character text display is active when  |
  329. 5220 REM |  is begins execution.                                              |
  330. 5230 REM ----------------------------------------------------------------------
  331. 5240 CLS
  332. 5250 GOSUB 500
  333. 5280 ON ERROR GOTO 5580:'Test for file available.
  334. 5290 OPEN ARCHFIL$ FOR INPUT AS #1:CLOSE #1
  335. 5300 ON ERROR GOTO 0:'Delete file not available error routine.
  336. 5310 IF INSTR(ARCHNAME$,":")=2 THEN OUTNAME$=LEFT$(ARCHNAME$,2)
  337. 5320 OPEN ARCHDIR$ AS #1 LEN=32
  338. 5330 OPEN ARCHFIL$ AS #2 LEN=128
  339. 5340 GET #1:'Skip directory itself.
  340. 5350 GET #1
  341. 5360 FIELD 1, 1 AS DONE$, 8 AS PRINAME$, 3 AS SECNAME$, 2 AS START$, 2 AS LAST$
  342. 5370 IF DONE$=CHR$(255) THEN GOSUB 6100:RUN:'Exit if complete
  343. 5380 IF DONE$=CHR$(254) THEN GOTO 5350:'Skip deleted entries
  344. 5390 IF INSTR(PRINAME$," ")>0 THEN O$=LEFT$(PRINAME$,(INSTR(PRINAME$," ")-1))+"."+SECNAME$ ELSE O$=PRINAME$+"."+SECNAME$
  345. 5400 OUTNAME$=OUTNAME$+O$
  346. 5410 PRINT:PRINT "Copying member ";O$;".":PRINT"   Re-specify filename or hit enter to use:";OUTNAME$;".";:INPUT I$
  347. 5420 IF I$="" THEN GOTO 5430 ELSE OUTNAME$=I$
  348. 5430 PRINT "   Opening file: ";OUTNAME$;" to copy ";128*CVI(LAST$);" bytes."
  349. 5440 OPEN OUTNAME$ AS #3 LEN=128
  350. 5450 ON ERROR GOTO 5600
  351. 5460 GOSUB 940
  352. 5530 ON ERROR GOTO 0
  353. 5540 PRINT "Copy completed for file: ";OUTNAME$
  354. 5550 CLOSE #3
  355. 5560 IF INSTR(ARCHNAME$,":")=2 THEN OUTNAME$=LEFT$(ARCHNAME$,2) ELSE OUTNAME$=""
  356. 5570 GOTO 5350
  357. 5580 IF ERR=53 THEN PRINT "File not found.":RESUME 5250
  358. 5590 ON ERROR GOTO 0
  359. 5600 'Error routine for input.
  360. 5610 IF ERR=50 AND ERL=5470 THEN ON ERROR GOTO 0:PUT #3:CLOSE #3:RESUME 5350
  361. 5620 ON ERROR GOTO 0
  362. 6000 CLS:SYSTEM
  363. 6100 LOCATE 25,1:PRINT"Hit ENTER to continue:";:LINE INPUT I$:RETURN
  364. 7000 REM ----------------------------------------------------------------------
  365. 7010 REM | Program Name: LUDEL -- A BASIC Library File Delete Routine         |
  366. 7020 REM | Purpose:                                                           |
  367. 7030 REM |  To delete a file currently in a library.                          |
  368. 7040 REM |  This program is based upon the LU library format by G. Novosielski|
  369. 7050 REM | Comments:                                                          |
  370. 7060 REM |  Input is an uncompressed library filename (without any extension).|
  371. 7070 REM |  This program deletes a file by changing the first byte to a       |
  372. 7080 REM |  hex FE. All other entries in the directory for this file are left |
  373. 7090 REM |  unchanged.                                                        |
  374. 7100 REM | Requires:                                                          |
  375. 7110 REM |  This program is written in IBM Personal Computer Disk BASIC.      |
  376. 7120 REM |  This program operates only in 80 character wide text mode. It     |
  377. 7130 REM |  assumes the screen is in that mode at entry.                      |
  378. 7140 REM ----------------------------------------------------------------------
  379. 7150 CLS
  380. 7160 GOSUB 500
  381. 7170 IF ARCHNAME$="" THEN GOSUB 6100:RUN
  382. 7180 ON ERROR GOTO 7610:'Test for file available.
  383. 7190 OPEN ARCHDIR$ FOR INPUT AS #1:CLOSE #1
  384. 7210 ON ERROR GOTO 0:'Delete file not available error routine.
  385. 7220 OPEN ARCHDIR$ AS #1 LEN=32
  386. 7230 CLS:PRINT "LUDEL    -    ";TITLE$
  387. 7240 GOSUB 720
  388. 7260 PRINT:INPUT "Enter file name to be deleted :";GETFIL$
  389. 7280 IF GETFIL$="" THEN GOSUB 6100:RUN
  390. 7290 IF LEN(GETFIL$)>12 THEN PRINT "ERROR - Filename is too long.":GOTO 7260
  391. 7300 FOR I=1 TO LEN(GETFIL$):'Translate to upper case.
  392. 7310 IF ASC(MID$(GETFIL$,I))>96 THEN MID$(GETFIL$,I)=CHR$(ASC(MID$(GETFIL$,I))-32)
  393. 7320 NEXT I
  394. 7330 IF INSTR(GETFIL$,".")<>0 THEN GETPRI$=LEFT$(GETFIL$,INSTR(GETFIL$,".")-1):GETSEC$=MID$(GETFIL$,INSTR(GETFIL$,".")+1)
  395. 7340 FOR I=2 TO NUMDIR+1
  396. 7350 GET #1,I
  397. 7360 FIELD 1, 1 AS DONE$, 8 AS PRINAME$, 3 AS SECNAME$, 2 AS START$, 2 AS LAST$
  398. 7370 IF DONE$=CHR$(254) THEN GOTO 7390
  399. 7380 IF GETPRI$+STRING$(8-LEN(GETPRI$)," ")=PRINAME$ THEN IF GETSEC$+STRING$(3-LEN(GETSEC$)," ")=SECNAME$ THEN GOTO 7410
  400. 7390 NEXT I
  401. 7400 PRINT:PRINT "ERROR - File not found.":GOTO 7260
  402. 7410 LSET DONE$=CHR$(254)
  403. 7420 PUT #1,I
  404. 7580 CLOSE
  405. 7590 PRINT:PRINT "LUDEL - Member deleted."
  406. 7600 GOSUB 6100:RUN
  407. 7610 IF ERR=53 THEN PRINT "ERROR - File not found.":RESUME 7160
  408. 7620 ON ERROR GOTO 0
  409. 7630 IF ERR=53 THEN RESUME 7540
  410. 7640 IF ERR=64 THEN PRINT"ERROR - Invalid filename specified.":RESUME 7420
  411. 7650 ON ERROR GOTO 0
  412. 7660 REM ----------------------------------------------------------------------
  413. 8000 REM -----------------------------------------------------------------------
  414. 8010 REM | Program Name: LUADD -- A BASIC Library Add File Routine             |
  415. 8020 REM | Purpose:                                                            |
  416. 8030 REM |  To add a new member to an existing library.                        |
  417. 8040 REM | Requires:                                                           |
  418. 8050 REM |  This program is written in IBM Personal Computer Disk BASIC.       |
  419. 8060 REM |  This program operates only in 80 character wide text mode. It      |
  420. 8070 REM |  assumes the screen is in that mode at entry.                       |
  421. 8080 REM -----------------------------------------------------------------------
  422. 8090 CLS
  423. 8100 GOSUB 500 ' Get Filename from User.
  424. 8110 IF ARCHNAME$="" THEN GOSUB 6100:RUN
  425. 8120 ON ERROR GOTO 8600:'Test for file available.
  426. 8125 OPEN ARCHDIR$ AS #1 LEN=32
  427. 8130 OPEN ARCHFIL$ AS #2 LEN=128
  428. 8135 GOSUB 720:' Go list directory for this file - and get highest sector in use in variable HILAST.
  429. 8137 PRINT:PRINT TOTDIR-NUMDIR;" files may be added to library ";ARCHNAME$
  430. 8138 IF TOTDIR-NUMDIR<1 THEN PRINT "No files can be added to this library.":GOSUB 6100:RUN
  431. 8140 PRINT:PRINT "Enter filenames to be added to library ";ARCHNAME$;". Enter null line to terminate."
  432. 8150 NUMFILES=0
  433. 8160 ON ERROR GOTO 8610
  434. 8170 NUMFILES=NUMFILES+1:PRINT "Filename #";NUMFILES;" <drv:filename.ext> :";:INPUT I$(NUMFILES)
  435. 8180 IF LEN(I$(NUMFILES))=0 THEN NUMFILES=NUMFILES-1:GOTO 8280
  436. 8190 FOR I=1 TO LEN(I$(NUMFILES))
  437. 8200 IF ASC(MID$(I$(NUMFILES),I))>96 THEN MID$(I$(NUMFILES),I)=CHR$(ASC(MID$(I$(NUMFILES),I))-32)
  438. 8210 NEXT I
  439. 8220 FOR J=1 TO NUMFILES-1
  440. 8230 IF I$(NUMFILES)=I$(J) THEN PRINT "ERROR - Same file specified twice.":NUMFILES=NUMFILES-1:GOTO 8170
  441. 8240 NEXT J
  442. 8250 OPEN I$(NUMFILES) FOR INPUT AS #3:CLOSE #3
  443. 8260 IF NUMFILES=TOTDIR-NUMDIR THEN GOTO 8280
  444. 8270 GOTO 8170
  445. 8280 ON ERROR GOTO 0
  446. 8290 IF NUMFILES<1 THEN PRINT "ERROR - No files specified.":GOTO 8140
  447. 8300 PRINT:PRINT NUMFILES;" files to be added to Library ";ARCHNAME$
  448. 8310 RECCNT=HILAST+LASTSEC:'Add new files to end of library.
  449. 8320 FOR I=1 TO NUMFILES
  450. 8330 INCNT=0
  451. 8340 OPEN I$(I) AS #3 LEN=128
  452. 8350 PRINT:PRINT "Copying file #";I;": ";I$(I);" (";LOF(3);"bytes ) --> Library: ";ARCHFIL$
  453. 8360 STARTCNT=RECCNT
  454. 8370 GOSUB 600 ' Go copy the file into the library.
  455. 8380 CLOSE #3
  456. 8390 CLOSE #2
  457. 8410 FIELD 1, 1 AS DONE$, 8 AS PRINAME$, 3 AS SECNAME$, 2 AS START$, 2 AS LAST$, 8 AS FILEDATE$, 8 AS FILETIME$
  458. 8420 LSET PRINAME$="":LSET SECNAME$=""
  459. 8430 LSET START$=MKI$(STARTCNT)
  460. 8440 LSET LAST$=MKI$(RECCNT-STARTCNT)
  461. 8450 LSET DONE$=CHR$(0)
  462. 8460 WKDATE$=DATE$:WKDATE$=LEFT$(WKDATE$,6)+RIGHT$(WKDATE$,2):LSET FILEDATE$=WKDATE$:LSET FILETIME$=TIME$
  463. 8470 IF INSTR(I$(I),":")=2 THEN PRI$=MID$(I$(I),3) ELSE PRI$=I$(I)
  464. 8480 IF INSTR(PRI$,".")<>0 THEN SEC$=MID$(PRI$,INSTR(PRI$,".")+1):PRI$=MID$(PRI$,1,INSTR(PRI$,".")-1)
  465. 8490 LSET PRINAME$=PRI$+SPACE$(8-LEN(PRI$))
  466. 8500 LSET SECNAME$=SEC$+SPACE$(3-LEN(SEC$))
  467. 8510 PUT #1,NUMDIR+I+1
  468. 8520 LSET DONE$=CHR$(255)
  469. 8530 PUT #1
  470. 8550 OPEN ARCHFIL$ AS #2 LEN=128
  471. 8560 NEXT I
  472. 8570 CLOSE
  473. 8580 PRINT:PRINT "LUADD completed - directory updated."
  474. 8590 GOSUB 6100:RUN
  475. 8600 IF ERR=53 THEN RESUME 1490 ELSE ON ERROR GOTO 0
  476. 8610 IF ERR=53 
  477. D completed - directory